Applying Machine Learning to Bitcoin Price Prediction

library(readxl)
library(caret)

## Loading required package: ggplot2

## Loading required package: lattice

library(tidyverse)         # for graphing and data cleaning

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

## ✓ tibble  3.1.6     ✓ dplyr   1.0.7
## ✓ tidyr   1.1.4     ✓ stringr 1.4.0
## ✓ readr   2.1.1     ✓ forcats 0.5.1
## ✓ purrr   0.3.4

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
## x purrr::lift()   masks caret::lift()

library(tidymodels)        # for modeling

## Registered S3 method overwritten by 'tune':
##   method                   from   
##   required_pkgs.model_spec parsnip

## ── Attaching packages ────────────────────────────────────── tidymodels 0.1.4 ──

## ✓ broom        0.7.10     ✓ rsample      0.1.1 
## ✓ dials        0.0.10     ✓ tune         0.1.6 
## ✓ infer        1.0.0      ✓ workflows    0.2.4 
## ✓ modeldata    0.1.1      ✓ workflowsets 0.1.0 
## ✓ parsnip      0.1.7      ✓ yardstick    0.0.9 
## ✓ recipes      0.1.17

## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## x scales::discard()        masks purrr::discard()
## x dplyr::filter()          masks stats::filter()
## x recipes::fixed()         masks stringr::fixed()
## x dplyr::lag()             masks stats::lag()
## x purrr::lift()            masks caret::lift()
## x yardstick::precision()   masks caret::precision()
## x yardstick::recall()      masks caret::recall()
## x yardstick::sensitivity() masks caret::sensitivity()
## x yardstick::spec()        masks readr::spec()
## x yardstick::specificity() masks caret::specificity()
## x recipes::step()          masks stats::step()
## • Search for functions across packages at https://www.tidymodels.org/find/

library(themis)            # for step functions for unbalanced data

## Registered S3 methods overwritten by 'themis':
##   method                  from   
##   bake.step_downsample    recipes
##   bake.step_upsample      recipes
##   prep.step_downsample    recipes
##   prep.step_upsample      recipes
##   tidy.step_downsample    recipes
##   tidy.step_upsample      recipes
##   tunable.step_downsample recipes
##   tunable.step_upsample   recipes

## 
## Attaching package: 'themis'

## The following objects are masked from 'package:recipes':
## 
##     step_downsample, step_upsample

library(doParallel)        # for parallel processing

## Loading required package: foreach

## 
## Attaching package: 'foreach'

## The following objects are masked from 'package:purrr':
## 
##     accumulate, when

## Loading required package: iterators

## Loading required package: parallel

library(stacks)            # for stacking models
library(naniar)            # for examining missing values (NAs)
library(lubridate)         # for date manipulation

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(moderndive)        # for King County housing data
library(vip)               # for variable importance plots

## 
## Attaching package: 'vip'

## The following object is masked from 'package:utils':
## 
##     vi

library(patchwork)         # for combining plots nicely
library(DALEX)

## Welcome to DALEX (version: 2.3.0).
## Find examples and detailed introduction at: http://ema.drwhy.ai/
## Additional features will be available after installation of: ggpubr.
## Use 'install_dependencies()' to get all suggested dependencies

## 
## Attaching package: 'DALEX'

## The following object is masked from 'package:dplyr':
## 
##     explain

library(DALEXtra)

## Anaconda not found on your computer. Conda related functionality such as create_env.R and condaenv and yml parameters from explain_scikitlearn will not be available

library(rpart)

## 
## Attaching package: 'rpart'

## The following object is masked from 'package:dials':
## 
##     prune

library(ggthemes)
theme_set(theme_minimal()) # Lisa's favorite theme

Introduction

Bitcoin, and other cryptocurrencies, have been present for over a decade, and have become increasingly prevalent in the global economic system. Bitcoin, the first and most widely used cryptocurrency, is used as a store of value, tradable asset, and a form of currency. This analysis aims to take advantage of the open-source blockchain network behind Bitcoin, and our goal is to understand the various factors that influence the price movement of Bitcoin.

Bitcoin popularized blockchain technology, and Satoshi Nakamoto used it to solve the Byzanztine’s General Problem and the double-spending problem without the need of a central authority. It is also the fastest growing asset class to have reached close to $2-3 trillion in market capitalization in over a decade. Given the recent technological adoption as seen with Tesla, Microstrategy & El Salvador’s government, we are particularly interested to examine the price movement of Bitcoin by looking at certain variables that are publically accessible through Bitcoin’s public ledger.

Data Sources

We used three different data sources: CoinMetrics, Glassnodes & FRED. We collected an overall of 162 variables with over 4000 observations; however, after basic explanatory analysis and cleaning, we ended up with 88 variables and 2,100 observations. CoinMetrics was the largest bulk of our data, where we used their public API to extract daily data from 2010 to present (November, 2021). We also secured a Glassnodes membership that gave access to daily changes in select variables not present in the CoinMetrics API. Taking from the previous literature review, we also decided to incorporate certain variables that have been examined in previous papers - CPI, Gold Price, Nasdaq & Bitcoin Google Search trends.

Loading the Data

We started with 11 years of data with 4000+ observations, and decided to cut our dataset to the most recent 5-years due to data-discrepancy and since Bitcoin was in its nascent stages earlier.

ADS_Project_11_29_2021_v8 <- read_excel("ADS_Project - 11.29.2021.v8.xlsx")

Data Preprocessing

We filtered through the variables and removed repetitive ones. For example, certain variables were displayed in USD and native units - we removed variables in native units to ensure consistency and standardization throughout. We also removed that overlap - NVT, adjusted, 90d MA & NVT, free float, 90d MA are examples of two that we removed to prevent over fitting.

Master <- ADS_Project_11_29_2021_v8 %>%
select(-c(`Last Calculated EOD metrics (time, in seconds)`, `Block Count`, `Block Size (mean, in bytes)`, `Block Weight, (mean`, `Capitalization of current supply, MVRV`, `Capitalization of free float, MVRV`, `Difficulty, Last Block`, `Difficulty, Mean Block`, `Mean Transaction Fee per Byte of all blocks, native units`, `Mean Transaction Fee per Byte, native units`, `Median Transaction Fee, native units`, `Median Fee per Transacation, USD`, `Addresses balance greater than 0.001 native units`, `Addresses balance greater than 0.01 native units`, `Addresses balance greater than 0.1 native units`,`Addresses balance greater than 100 native units`, `Addresses balance greater than 100K native units`, `Addresses balance greater than 10 native units`, `Addresses balance greater than 10K native units`, `Addresses balance greater than 1 native units`, `Addresses balance greater than 1K native units`, `Addresses balance greater than 1M native units`, `Addresses balance greater than 1in100K`, `Addresses balance greater than 1in100M`, `Addresses balance greater than 1in10B`, `Addresses balance greater than 1in10K`, `Addresses balance greater than 1in10K`, `Addresses balance greater than 1in10M`, `Addresses balance greater than 1in1B`, `Addresses balance greater than 1in1K`, `Addressesbalance greater than 1in1M`, `Total Fees, native units`, `Flow to exchanges, native units`, `Flow out exchanges, native units`, `Gas Limit Block`, `Gas Limit, transaction`, `Gas Used, transaction`, `Hash Rate Mean, 30d`, `Issuance, native units`, `Issuance, percent annualized`, `Issuance,  percent daily`, `Issuance Total, native units`,`NVT, adjusted, 90d MA`, `NVT, adjusted, free float,  90d MA`, `ROI, 1y (%)`, `Revenue, per hash unit (Native Currency)`, `Revenue Daily, per hash unit/second (Native Currency)`, `Miner Rev (Native Currency)`, `Supply, 10y Active`, `Supply, 5yr Active`, `Supply, 4yr Active`, `Supply, 3yr Active`, `Supply, 1yr Active Trailing (%)`, `Supply, in addresses (<0.001, native currency)`, `Supply, in addresses (<0.01M, native currency)`, `Supply, in addresses (<0.1, native currency)`, `Supply, in addresses (<1, native currency)`, `Supply, in addresses (<10, native currency)`, `Supply, in addresses (<100, native currency)`, `Supply, in addresses (<100K, native currency)`, `Supply, in addresses (<10K, native currency)`, `Supply, in addresses (<1K, native currency)`, `Supply, in addresses (<1M, native currency)`, `Supply, Miner address with 1 mining entity (native currency)`, `Supply, All Miners (native currency)`, `Transactions, adjusted transfer value (native currency)`, `Transactions, mean transfer value (native currency)`, `Transactions, median transfer value (native currency)`, `Transactions, mean transfer value ($)`, `Transactions, median transfer value (native currency)`, `Velocity, 1yr current supply`, `Volatility, 180d daily returns`, `Volatility, 30d daily returns`, `Price, BTC`, `Price, ($)`, `Transactions, median transfer value ($)`))

We arrived at 88 variables and 2145 observations. We then plotted over 60 graphs and removed certain variables that either did not have any correlation to the output or where other variables had a visually overlapping effect. Below are plots of select variables that we removed during this process.

ggplot(Master,
       aes(x = `Hash Rate, mean`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) + theme_economist()

## `geom_smooth()` using formula 'y ~ x'

ggplot(Master,
       aes(x = `Issuance, in USD`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) + theme_economist()

## `geom_smooth()` using formula 'y ~ x'

ggplot(Master,
       aes(x = `Issuance Total, in USD`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) + theme_economist()

## `geom_smooth()` using formula 'y ~ x'

ggplot(Master,
       aes(x = `Supply, 30D Active`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) + theme_economist()

## `geom_smooth()` using formula 'y ~ x'

ggplot(Master,
       aes(x = `Supply, 7D Active`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) + theme_economist()

## `geom_smooth()` using formula 'y ~ x'

ggplot(Master,
       aes(x = `Supply, 90D Active`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE)+ theme_economist()

## `geom_smooth()` using formula 'y ~ x'

Consequently, the graphical explandatory data analysis showed certain variables that demonstrated a strong corelation to the output. Some of these variables can be seen below.

ggplot(Master,
       aes(x = `Gas Limit Block, mean`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) + theme_economist()

## `geom_smooth()` using formula 'y ~ x'

ggplot(Master,
       aes(x = `NVT, adjusted`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) +
   theme_economist()

## `geom_smooth()` using formula 'y ~ x'

ggplot(Master,
       aes(x = `Supply, in addresses (<$10M)`,
           y = `Price`)) + 
         geom_point() + 
         geom_smooth(method = lm, se = FALSE) +
   theme_economist()

## `geom_smooth()` using formula 'y ~ x'

The code below shows the variables we removed after plotting most of the graphs as seen above. This further dropped our variable count from 88 variables to 27.

Master <- Master %>% select(-c(`Gas limit Mean, transaction`, `Hash Rate, mean`, `Issuance, in USD`, `Issuance Total, in USD`, `ROI, 30D (%)`, `Revenue Daily, per hash unit/second (USD)`, `Revenue, per hash unit ($)`, `Supply Equality Ratio`, `Supply, 180D Active`, `Supply, 1yr Active`, `Supply, 2y Active`, `Supply, 1yr Active`, `Supply, Miner address with 1 mining entity ($)`, `Transactions, count`,`Transactions, count (per second)`, `Transactions, adjusted transfer value ($)`, `Coin_Days_Destroyed`, `Balance_Exchanges_(%)`, `Total_Exchange_Inflow_Volume`, `Supply, 30D Active`, `Supply, 7D Active`, `Supply, 90D Active`, `Supply, address balance (<1in10K)`, `Supply, address balance (<1in10M)`, `Supply, address balance (<1in10B)`, `Supply, address balance (<1in10K)`, `Supply, address balance (<1in1B)`, `Supply, address balance (<1in1K)`, `Supply, address balance (<1in1M)`, `Supply, in addresses (<$1)`, `Supply, in addresses (<$10)`, `Supply, in addresses (<$100)`, `Supply, in addresses (<$100K)`, `Supply, in addresses (<$10K)`, `Supply, in addresses (<$10M)`, `Supply, in addresses (<$1K)`, `Supply, held by top 1% addresses`, `Supply, 10yr expected supply`, `Supply, free float`, `Supply, All Miners ($)`, `Supply, Miner address with 1 mining entity ($)`, `Transactions, count`, `Transactions, adjusted transfer value ($)`, `Coin_Days_Destroyed`, `CPI_(%)`))

Master <- Master %>% select(-c(`All Addresses balance`, `Addresses balance greater than $100`, `Addresses balance greater than $10`, `Addresses balance greater than $1`, `Capitalization of active native units supply, in USD`, `Capitalization of free float, in USD`, `Capitalization realized, USD`, `NVT, adjusted, free float`, `Miner Rev ($)`, `Supply, current`, `Flow transfers exchanges`, `Supply, address balance (<1in100M)`, `Supply, in addresses (<$1M)`, `Transactions, transfer count`, `NUPL`, `rHODL`, `Addresses Active Count`,`Addresses balance greater than $10K`, `Addresses balance greater than $100K`, `Addresses balance greater than $1K`, `Addresses balance greater than $1M`, `Block, weight, total`))

In the section below, we carry out further pre-processing. We start by converting the Date into numeric format from character, so this will not cause problems when building the recipes for the models moving forward. We also introduce a few new variables which represent the lagged characteristics of the Prices such as lag1day which essentially enables each observation to obtain more than 1 price variable; hence the Price variable will represent that specific days price and lag1day will represent the previous day’s price.

 Master <- Master %>%
           mutate(Date = ymd(Date)) %>% 
           mutate(Date_num = as.numeric(Date)) %>%
           mutate(lag1day = lag(Price, 1, order_by = Date),
                  lag7day = lag(Price, 7, order_by = Date)) %>%
           replace_na(list(lag1day = 0, lag7day = 0)) %>% 
           mutate(Daily_avg = (Price + lag1day)/2,
                  Weekly_avg = (Price + lag7day)/7) %>%
           select(-c(CPI, `BTC(%)`, `NDQ(%)`, `Gold(%)`, BTC_Searches, `BTCS(%)`))

---

Machine Learning Models

We make use of three core models in our analysis — + Lasso Classification + Random Forest + Decision Trees

We also carry out further exploratory analysis with Support Vector Machines to see how it performs

Lasso - Binary Classification

Initially, we wanted to use a lasso predictive regression which would model a quantitative Y variable (Price). Upon preliminary model building and testing, we observed that the model performed very poorly with this approach. This was likely due to Bitcoin having extremely volatile prices creating increased variation and noise which made modelling it accurately difficult. Hence, we moved forward with a binary lasso classification.

In building the Lasso, we created a new variable called PriceDirection which would allow us to look at price actions in a binary structure with the help of the lagged variables. We define the main dependent variable by passing on a logical condition whereby if Price is greater than lag1day, then the condition is true and represents a price increase (1). If the condition fails, it will translate to a price decrease (0). This is shown below.

Master <- Master %>% mutate(Date = ymd(Date)) %>% 
           mutate(Date_num = as.numeric(Date)) %>%
           mutate(PriceDirection = ifelse(Price > lag1day, yes = 1, no = 0)) %>%
           mutate(PriceDirection = as.factor(PriceDirection)) 

We take a proportional split of 3/4 for the split between Train and Test, whereby 0.75 is attributed to the training set and 0.25 is used for testing. Given the rapid acceleration in the price of Bitcoin over the years, we decided not to use a time split.

set.seed(456)
Master_Split <- initial_split(Master, prop = 0.75)

Master_Training <- training(Master_Split)
Master_Testing <- testing(Master_Split)

In the next step, we prepare the Lasso model recipe. We remove Date since the recipe building can only process numeric data structures. We also exclude Network Distribution Factor, Capitalization of Current Supply, in USD, and Supply, held by top 10% addresses as these variables demonstrated issues of Endogeneity. We also exclude other variables which are not used for this section.

lasso_recipe <- recipe(PriceDirection ~ .,
                       data = Master_Training) %>%
                step_rm(Date, Weekly_avg, Daily_avg, lag7day, lag1day, `Network distribution factor`, `Capitalization of Current Supply, in USD`, `Supply, held by top 10% addresses`) %>%
                step_mutate_at(all_numeric(), -all_outcomes(), fn= ~ as.numeric(.)) %>%
                step_dummy(all_nominal(), -all_outcomes()) %>%
                update_role(Date_num, new_role = "ID") %>%
                step_zv(all_predictors()) %>%
                step_normalize(all_predictors(), -all_nominal())

lasso_recipe %>% prep() %>% juice()

lasso_mod <- logistic_reg(mixture = 1) %>%
             set_engine("glmnet") %>% 
             set_args(penalty = tune()) %>% 
             set_mode("classification")

lasso_wf <- workflow() %>%
            add_recipe(lasso_recipe) %>%
            add_model(lasso_mod) 

set.seed(494)
btc_cv <- vfold_cv(Master_Training,
                   v = 10)

penalty_grid <- grid_regular(penalty(),
                             levels = 10)

ctrl_grid <- control_stack_resamples()

metric <- metric_set(accuracy)

lasso_tune <- lasso_wf %>%
              tune_grid(resamples = btc_cv,
                        grid = penalty_grid,
                        control = ctrl_grid)

lasso_tune %>% collect_metrics()

best_param <- lasso_tune %>%
              select_best(metric = "accuracy")
best_param

final_lasso <- lasso_wf %>% finalize_workflow(best_param) %>%
               fit(data = Master_Training)

final_lasso %>% pull_workflow_fit() %>% tidy()

## Warning: `pull_workflow_fit()` was deprecated in workflows 0.2.3.
## Please use `extract_fit_parsnip()` instead.

library(vip)
final_lasso %>% 
      fit(Master_Training) %>%
      extract_fit_parsnip() %>%
      vi(lamda = lowest_rmse$penalty) %>%
      mutate(Importance = abs(Importance),
             Variable = fct_reorder(Variable, Importance)) %>%
     ggplot(aes(x = Importance, y = Variable, fill = Sign)) +
     geom_col() + 
     scale_x_continuous(expand = c(0,0)) +
     labs(y = NULL)

lasso_fit <- final_lasso %>%
  last_fit(Master_Split)

lasso_fit

test_performance_lasso <- lasso_fit %>% collect_metrics()
test_performance_lasso

The Lasso classification model selects the variables based in the magnitude of their coefficients. We built the Lasso by using a penalty grid level of 10, CV resampling of 10 folds, and moved forward by selecting the tuning parameter with the highest prediction accuracy as the parameter for the final model. As shown above, the prediction accuracy for the lasso model is 59.4%, predicting the correct price movement 59.4% of the time with Receiver operating characteristic area under curve of 62%.

Random Forest - Classification

The next model we use is a Random Forest. Similar to the lasso model, we take most of the same concepts and ideas in building the model with PriceDirection being the main dependent variable. We adjust for the removal of the variables we excluded in the lasso for the same reasons as above.

We build our random forest model using 10 trees with penalty grid of level 3 to tune the forest and a resampling CV of 10 folds. The model returns the the mode of the predictions for the 10 trees.

set.seed(456)
rf_recipe <- recipe(PriceDirection ~.,
                    data = Master_Training) %>%
             step_mutate_at(all_numeric(), fn = ~as.numeric(.)) %>%
             step_rm(Weekly_avg, Daily_avg, lag7day, lag1day, `Network distribution factor`, `Capitalization of Current Supply, in USD`, `Supply, held by top 10% addresses`) 

rf_recipe %>% prep() %>% juice()

rf_model <- rand_forest(mtry = tune(),
                        min_n = tune(),
                        trees = 10) %>%
            set_mode("classification") %>%
            set_engine("ranger")

rf_workflow <- workflow() %>%
               add_recipe(rf_recipe) %>%
               add_model(rf_model)

rf_penalty_grid <- grid_regular(finalize(mtry(),
                                Master_Training %>%
                                select(-PriceDirection)),
                                min_n(),
                                levels = 2)

rf_tune <- rf_workflow %>%
           tune_grid(resamples = btc_cv,
                     grid = rf_penalty_grid,
                     control = control_stack_grid())

## ! Fold01: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold01: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold02: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold02: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold03: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold03: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold04: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold04: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold05: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold05: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold06: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold06: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold07: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold07: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold08: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold08: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold09: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold09: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

## ! Fold10: preprocessor 1/1, model 2/4: 26 columns were requested but there were 19...

## ! Fold10: preprocessor 1/1, model 4/4: 26 columns were requested but there were 19...

rf_tune %>% collect_metrics()

best_param_rf <- rf_tune %>%
              select_best(metric = "accuracy")
best_param_rf

rf_final <- rf_workflow %>% finalize_workflow(best_param_rf)
rf_fit <- rf_final %>%
  last_fit(Master_Split)

## ! train/test split: preprocessor 1/1, model 1/1: 26 columns were requested but there were 19...

rf_fit

test_performance_rf <- rf_fit %>% collect_metrics()
test_performance_rf

We observe that the random forest performs poorly compared to the lasso model. Our best performing random forest model with the best tuned parameter has a prediction accuracy of 52.3% when tested against the test split. The highest prediction accuracy is seen for tuning parameter mtry = 26 and min_n = 2 with a prediction accuracy of 56.3%.

Decision tree

The last model we use to create a stacked model is a decision tree. We utilize the same recipe built for the random forest to build the tree model with the same parameters. The results we obtained below were suprising because the tree model outperforms the random forest model with model prediction accuracy of 59.8% and test accuracy of 60%. The tree model delivers the highest prediction accuracy for testing among all the three models.

#decision trees
set.seed(456)

tree_model <-
  decision_tree() %>%
  set_mode("classification") %>%
  set_engine("rpart")

tree_workflow <-
  workflow() %>%
  add_recipe(rf_recipe) %>%  
  add_model(tree_model)

tree_fit <-
  tree_workflow %>%
  fit_resamples(btc_cv,
                control = control_stack_resamples()
  )

collect_metrics(tree_fit)

best_param_tree <- tree_fit %>%
              select_best(metric = "accuracy")
best_param_tree

tree_final <- tree_workflow %>% finalize_workflow(best_param_rf)

Tree_fit <- tree_final %>%
  last_fit(Master_Split)

Tree_fit

test_performance_tree <- Tree_fit %>% collect_metrics()
test_performance_tree

Stacking

lasso_tune %>%
  collect_metrics()

rf_tune %>%
  collect_metrics()

tree_fit %>%
  collect_metrics()

Models_stack <-
  stacks() %>%
  add_candidates(lasso_tune) %>%
  add_candidates(rf_tune) %>%
  add_candidates(tree_fit)

Models_blend <-
  Models_stack %>%
  blend_predictions()
Models_blend

## ── A stacked ensemble model ─────────────────────────────────────

## 
## Out of 10 possible candidate members, the ensemble retained 5.
## Penalty: 0.01.
## Mixture: 1.

## 
## The 5 highest weighted member classes are:

## # A tibble: 5 × 3
##   member                  type          weight
##   <chr>                   <chr>          <dbl>
## 1 .pred_1_lasso_tune_1_07 logistic_reg  2.10  
## 2 .pred_1_lasso_tune_1_08 logistic_reg  0.930 
## 3 .pred_1_tree_fit_1_1    decision_tree 0.898 
## 4 .pred_1_rf_tune_1_2     rand_forest   0.110 
## 5 .pred_1_rf_tune_1_4     rand_forest   0.0553

## 
## Members have not yet been fitted with `fit_members()`.

Model_final_stack <- Models_blend %>%
  fit_members() 

Data Visualization

Master %>% 
  select(`Price`, `Date_num`, `SOPR`, `Adjusted_Dormancy_Flow`) %>%
  pivot_longer(cols=-`Date_num`, names_to = "variable", values_to = "values") %>% 
  ggplot(aes(`Date_num`, `values`)) + geom_line() + facet_wrap(vars(`variable`), ncol = 1, scales = "free_y") + theme_wsj()

This plot shows the dormancy flows of dormant coins throughout a bitcoin cycle. For example, at the peak of the cycle in 2018 (Date_num < 17500), most of the the dormant coins were being trasacted and tranferred across changes. It comes to show how in the current cycle the dormant coins have not reached that level of transactions and movement. The SOPR, on the other hands, helps understand short-term price movement. During large dumps, like March 2020 (Date_num < 18500), we see how the SOPR drops significantly around 0.9, while it reaches closer to 1.10 at bull market local peaks.

Master %>% 
  select(`Price`, `Date_num`, `Supply, held by top 100 addresses`, `Supply, Total Active`) %>%
  pivot_longer(cols=-`Date_num`, names_to = "variable", values_to = "values") %>% 
  ggplot(aes(`Date_num`, `values`)) + geom_line() + facet_wrap(vars(`variable`), ncol = 1, scales = "free_y") + theme_wsj()

One of the interesting variables to examine is Supply, held by the top 100 addresses. These are the largest bitcoin holders, and their holdings often dictate the price direction of Bitcoin - this is primarily due to the fact that they have experienced multiple cycles, can anticipate how the current cycle may play out, and potentially because they hold greater information about upcoming price catalysts. Them increasing their holdings significantly during the March 2020 dump could be a potential indicator to frontrun a large increase in the price of bitcoin.

Master %>% 
  select(`Price`, `Date_num`, `Coin_Years_Destroyed`, `NVT, adjusted`) %>%
  pivot_longer(cols=-`Date_num`, names_to = "variable", values_to = "values") %>% 
  ggplot(aes(`Date_num`, `values`)) + geom_line() + facet_wrap(vars(`variable`), ncol = 1, scales = "free_y") + theme_wsj()

The Network Value to Transaction helps understand the relationship between transfer volume and the market cap of Bitcoin. In order words, a higher NVT indicates that the valuation of the Bitcoin network is greater than the transaction volume (a more intrinsic value indicator). The blow-off top in 2018 could be anticipated by the sudden increase in NVT, which would indicate a bubble-like behavior in terms of Bitcoin’s transaction volume vs it’s market cap.

Below are additional graphs plotted with the price of Bitcoin over the span of 5 years.

Master %>% 
    select(`Price`, `Date_num`,`Miner Rev, Total ($)`, `Total Fees, USD`) %>%
  pivot_longer(cols=-`Date_num`, names_to = "variable", values_to = "values") %>% 
  ggplot(aes(`Date_num`, `values`)) + geom_line() + facet_wrap(vars(`variable`), ncol = 1, scales = "free_y") + theme_wsj()

Master %>% 
  select(`Price`, `Date_num`, `Gas Limit Block, mean`, `Addresses balance greater than $10M`) %>%
  pivot_longer(cols=-`Date_num`, names_to = "variable", values_to = "values") %>% 
  ggplot(aes(`Date_num`, `values`)) + geom_line() + facet_wrap(vars(`variable`), ncol = 1, scales = "free_y") + theme_wsj()

Master %>% 
    select(`Price`, `Date_num`,`Flow out exchanges, USD`, `Mean Fee per Transaction, USD`) %>%
  pivot_longer(cols=-`Date_num`, names_to = "variable", values_to = "values") %>% 
  ggplot(aes(`Date_num`, `values`)) + geom_line() + facet_wrap(vars(`variable`), ncol = 1, scales = "free_y") + theme_wsj()

Data Dictionary

Spent Output Profit Ratio (SOPR): Price Paid / Price Sold Gas Limit Block, Mean: Sum gas limit of all block from that interval Adjusted Dormancy Flow: Market Cap/Annualized Dormancy Value Coin Years Active: Coins Transacted / # of Days Since Last Transacted NVT, Adjust: Market Cap/Transfer Volume

Supplementary Model

SVM - Classification

We also carry out supplementary analysis with Support Vector Machines because of their advantages in classification tasks. We observe that for the main Support vector machine model we built, the prediction accuracy does not differ by a considerable rate from the three models we have used above.

Master_2 <- Master %>%
            mutate("PriceDirection" = factor(ifelse(PriceDirection == "1" | PriceDirection != "0",
                                                    "Price_Increase", "Price_Decrease"),
                                                    levels = c("Price_Increase", "Price_Decrease")))

Master_Split2 <- initial_split(Master_2, prop = 0.75)

Master_Training2 <- training(Master_Split2)
Master_Testing2 <- testing(Master_Split2)

btc_cv2 <- vfold_cv(Master_Training2,
                   v = 10)

svm_rec <- 
  recipe(PriceDirection ~ ., data = Master_2) 

svm_spec <-
  svm_rbf(cost = tune(), rbf_sigma = tune()) %>%
  set_mode("classification") %>%
  set_engine("kernlab")

svm_wflow <- 
  workflow() %>% 
  add_model(svm_spec) %>% 
  add_recipe(svm_rec)

cost()

## Cost (quantitative)
## Transformer:  log-2 
## Range (transformed scale): [-10, 5]

rbf_sigma()

## Radial Basis Function sigma (quantitative)
## Transformer:  log-10 
## Range (transformed scale): [-10, 0]

svm_param <- 
  svm_wflow %>% 
  parameters() %>% 
  update(rbf_sigma = rbf_sigma(c(-7, -1)))

start_grid <- 
  svm_param %>% 
  update(
    cost = cost(c(-6, 1)),
    rbf_sigma = rbf_sigma(c(-6, -4))) %>% 
  grid_regular(levels = 2)

set.seed(456)

svm_initial <- 
  svm_wflow %>% 
  tune_grid(resamples = btc_cv2, 
            grid = start_grid, 
            control = control_stack_grid())

collect_metrics(svm_initial)

best_param_svm <- svm_initial %>%
              select_best(metric = "accuracy")
best_param_svm

Bayesian Optimization for SVM

ctrl <- control_bayes(verbose = TRUE)

set.seed(420)

svm_bo <-
  svm_wflow %>%
  tune_bayes(
    resamples = btc_cv2, 
    metrics = NULL, 
    initial = svm_initial, # tune_grid object produced earlier
    param_info = svm_param, # specified earlier too, with our new bounds for rbf_sigma
    iter = 27, # maximum number of search iterations
    control = ctrl
  )

## Optimizing roc_auc using the expected improvement

## 

## ── Iteration 1 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.5997 (@iter 0)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.00255, rbf_sigma=0.00011

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5991 (+/-0.0129)

## 

## ── Iteration 2 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.5997 (@iter 0)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.000999, rbf_sigma=2.29e-06

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5939 (+/-0.0137)

## 

## ── Iteration 3 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.5997 (@iter 0)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=14.3, rbf_sigma=0.000296

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.6046 (+/-0.0141)

## 

## ── Iteration 4 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.6046 (@iter 3)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=4.2, rbf_sigma=0.00123

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.6052 (+/-0.0133)

## 

## ── Iteration 5 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.6052 (@iter 4)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.1, rbf_sigma=0.00299

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.6536 (+/-0.0129)

## 

## ── Iteration 6 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.6536 (@iter 5)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=18.9, rbf_sigma=0.0039

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.6426 (+/-0.0124)

## 

## ── Iteration 7 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.6536 (@iter 5)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=1.02, rbf_sigma=0.00282

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5977 (+/-0.0128)

## 

## ── Iteration 8 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.6536 (@iter 5)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.7, rbf_sigma=0.00229

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.6499 (+/-0.0131)

## 

## ── Iteration 9 ─────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.6536 (@iter 5)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=29.5, rbf_sigma=0.00282

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.6507 (+/-0.0131)

## 

## ── Iteration 10 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.6536 (@iter 5)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.2, rbf_sigma=0.0673

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.7011 (+/-0.0124)

## 

## ── Iteration 11 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7011 (@iter 10)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.7, rbf_sigma=0.069

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.7014 (+/-0.0124)

## 

## ── Iteration 12 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7014 (@iter 11)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.4, rbf_sigma=0.0899

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.6937 (+/-0.012)

## 

## ── Iteration 13 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7014 (@iter 11)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=30.9, rbf_sigma=0.0447

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.7058 (+/-0.0109)

## 

## ── Iteration 14 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7058 (@iter 13)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.5, rbf_sigma=0.0366

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.7075 (+/-0.0101)

## 

## ── Iteration 15 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7075 (@iter 14)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.00101, rbf_sigma=0.0911

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5814 (+/-0.0114)

## 

## ── Iteration 16 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7075 (@iter 14)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.7, rbf_sigma=0.0281

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.7058 (+/-0.00991)

## 

## ── Iteration 17 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7075 (@iter 14)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.094, rbf_sigma=0.0996

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5823 (+/-0.012)

## 

## ── Iteration 18 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7075 (@iter 14)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=30.7, rbf_sigma=1.08e-07

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.6013 (+/-0.0116)

## 

## ── Iteration 19 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7075 (@iter 14)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.8, rbf_sigma=0.0345

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.7076 (+/-0.0102)

## 

## ── Iteration 20 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7076 (@iter 19)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.9, rbf_sigma=0.0329

## i Estimating performance

## ✓ Estimating performance

## ♥ Newest results:    roc_auc=0.7078 (+/-0.00976)

## 

## ── Iteration 21 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7078 (@iter 20)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.00121, rbf_sigma=1.04e-07

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.597 (+/-0.0144)

## 

## ── Iteration 22 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7078 (@iter 20)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.0942, rbf_sigma=1.08e-07

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5864 (+/-0.0209)

## 

## ── Iteration 23 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7078 (@iter 20)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.00983, rbf_sigma=0.00402

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5978 (+/-0.0139)

## 

## ── Iteration 24 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7078 (@iter 20)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=31.6, rbf_sigma=6.53e-06

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5999 (+/-0.014)

## 

## ── Iteration 25 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7078 (@iter 20)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.163, rbf_sigma=1.5e-05

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5981 (+/-0.0131)

## 

## ── Iteration 26 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7078 (@iter 20)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=2.2, rbf_sigma=0.0941

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.616 (+/-0.00825)

## 

## ── Iteration 27 ────────────────────────────────────────────────────────────────

## 

## i Current best:      roc_auc=0.7078 (@iter 20)

## i Gaussian process model

## ✓ Gaussian process model

## i Generating 5000 candidates

## i Predicted candidates

## i cost=0.00105, rbf_sigma=0.00144

## i Estimating performance

## ✓ Estimating performance

## ⓧ Newest results:    roc_auc=0.5974 (+/-0.0138)

show_best(svm_bo)

## Warning: No value of `metric` was given; metric 'roc_auc' will be used.

svm_bo %>% collect_metrics()